1 CLR:POKE53272,21:POKE53280,1:POKE53281,1:CR$=CHR$(13):PRINT"[144]":REMC64 MODS 1983
2 REM WEIGHT WATCHER BY M. CRITCHFIELD & T. DWYER
3 REM FROM THE NOVEMBER 1979 ISSUE OF
4 REM 'KILOBAUD' MAGAZINE  PAGE 156-157
5 REM MODIFIED FOR THE PET BY
6 REM R. E. HUTCHINGS
9 REM INPUT ROUTINE USED WITH PERMISSION FROM CURSOR, BOX550, GOLETA, CA 93017
15 GOSUB3000
18 PRINT"[147]      WEIGHT WATCHER'S RECORD"
20 PRINT:PRINT"WEEK","WEIGHT","WT. LOSS"
30 S=0:D=0
35 REM-----CALC. & PRINT TABLE-----
40 READG
45 I=0
50 I=I+1
60 READ W
70 IFI=1THEN110
80 IFW<0THEN140
90 D=W1-W
100 S=S+D
110 PRINTI,W,D
120 W1=W
125 IFI=16THENGOTO8000
126 IFI=32THENGOTO8000
127 IFI=48THENGOTO8000
128 IFI=64THENGOTO8000
129 IFI=80THENGOTO8000
130 GOTO50
135 L=INT(100*(S/(I-1)))
140 L=INT(100*(S/(I-1)))
145 PRINT:PRINT"AVG. WEEKLY LOSS  ";L/100;"LBS."
150 PRINT"LBS. TO GOAL  ";W1-G;"   GOAL =";G
160 PRINT"TOTAL POUNDS LOST SO FAR  ";S
165 PRINT"    PRESS ANY KEY TO CONTINUE"
167 GETA$:IFA$=""THENGOTO167
170 PRINT"[147]          WEIGHT WATCHER'S GRAPH":PRINT
175 REM-----STANDARD SCALE (110-170)----
180 A=110:B=170
190 GOSUB315
250 REM-----CUSTOMIZED SCALE----------
260 PRINT"     WANT A CUSTOMIZED GRAPH ? ";:GOSUB60000
270 IFLEFT$(IN$,1)<>"Y"THEN2000
280 PRINT"[147]WHAT IS THE SMALLEST NUMBER ? ";
290 GOSUB60000:A=VAL(IN$)
300 PRINT"WHAT IS THE LARGEST NUMBER ?  ";
301 GOSUB60000:B=VAL(IN$)
302 PRINT"[147]":IF(B-A)>60THENGOTO7000
303 IFB<=ATHENGOTO7500
304 PRINT:GOSUB315
305 PRINT"        WANT ANOTHER GRAPH ? ";:GOSUB60000
307 IFIN$="YES"THEN280
308 IFIN$="Y"THEN280
309 GOTO2000
315 REM-----GRAPH SUBROUTINE-----
316 X=0
317 REM-----HEADING (LINE 1)-----
320 IFB=0THENB=.00001
330 FORI=ATOBSTEP10
340 PRINTTAB(X*10*(30/(B-A))+5);I;
350 X=X+1
360 NEXTI
370 PRINT
375 REM-----HEADING (LINE 2)-----
376 PRINT"     [192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][145]"
380 PRINT"    [176]";
390 FORI=0TO(X-1)
400 PRINTTAB(I*30*(10/(B-A))+7);"[178]";
410 NEXTI
420 PRINT
425 RESTORE
426 READG
428 REM-----PRINT GRAPH-----
429 I=0
430 I=I+1
440 READW
450 IFW<0THEN480
454 IFW<ATHENPRINTI;TAB(4);"[171]";TAB(15)"OUT OF RANGE":GOTO465
455 IFW>BTHENPRINTI;TAB(4);"[171]";TAB(15)"OUT OF RANGE":GOTO465
460 PRINTI;TAB(4);"[171]";TAB((W-A)*(30/(B-A))+6);"*"
465 IFI=16GOTO8500
466 IFI=32GOTO8500
467 IFI=48GOTO8500
468 IFI=64GOTO8500
469 IFI=80GOTO8500
470 GOTO430
480 RETURN
996 REM********************************
997 REM     INSERT DATA HERE
998 REM
999 REM********************************
1000 DATA122,153,149.5,147.5,147.5,145,144.5,141,141.5,139.25
1010 DATA139.5,137.5,138.5,137,136.5,136,135,135,133,134,133,132,130,129,134
1020 DATA -1
1997 REM*******************************
1998 REM
2000 PRINT"[147]            KEEP DIETING"
2010 T=TI
2020 IFTI-T<180THEN2020
2030 PRINT"[147]":END
3000 PRINT"[147]     WANT DIRECTIONS ? ";:GOSUB60000
3010 IFLEFT$(IN$,1)<>"Y"THEN18
3020 PRINT"[147]WEIGHT WATCHER                  PAGE 1
3030 [153]"--------------------------------------"
3040 [153]"THIS PROGRAM ENABLES YOU TO KEEP TRACK"
3050 [153]"OF YOUR DIETING EFFORTS AND MAKE A "
3060 [153]"CHART OF YOUR PROGRESS (OR LACK OF"
3070 [153]"PROGRESS).  A SAMPLE DISPLAY IS IN-"
3080 [153]"CLUDED.  YOU CAN CUSTOMIZE THE CHART"
3090 [153]"SCALE TO EXPAND OR CONTRACT IT.  JUST "
3100 [153]"FOLLOW THE DIRECTIONS IN THE  PROGRAM."
3110 [153]"PUT THE RESULTS OF YOUR WEEKLY WEIGH-"
3120 [153]"IN AS PART OF THE DATA STATEMENTS"
3130 [153]"STARTING AT LINE 1000."
3135 [141]4000
3140 [153]"YOUR GOAL MUST BE THE FIRST DATA ENTRY "
3150 [153]"WITH -1 AS THE FINAL DATA ENTRY."
3160 [153]"GOOD LUCK IN REACHING YOUR GOAL."
3165 [153]"YOU LOOK THINNER ALREADY."
3170 [141]5000
3180 [142]
4000 [153]"---------------------------------------"
4010 [153]"      PRESS ANY KEY TO CONTINUE"
4020 [161]A$:[139]A$[178]""[167]4020
4030 [153]"LOADWEIGHT WATCHER                  PAGE 2
4040 PRINT"--------------------------------------"
4050 RETURN
5000 PRINT"---------------------------------------"
5010 PRINT"      PRESS ANY KEY TO BEGIN"
5020 GETA$:IFA$=""THEN5020
5030 RETURN
7000 PRINT"     THE MAXIMUM RANGE IS 60 POUNDS"
7010 FOR I=1TO1000:NEXTI
7020 GOTO260
7500 PRINT"          HOW'S THAT AGAIN ?"
7510 FORI=1TO1000:NEXTI
7520 GOTO260
8000 PRINT"      PRESS ANY KEY TO CONTINUE"
8010 GETA$:IFA$=""THEN8010
8012 PRINT"                                       "
8014 FORJ=1TO20
8015 PRINT"                                      "
8016 NEXTJ
8017 PRINT""
8020 GOTO50
8500 PRINT"      PRESS ANY KEY TO CONTINUE"
8510 GETA$:IFA$=""THEN8510
8512 PRINT"                                       "
8514 FORJ=1TO18
8515 PRINT"                                      "
8516 NEXTJ
8517 PRINT""
8520 GOTO430
60000 IN$=" ":ZT=TI:ZC=2:ZD$=CHR$(20)
60010 GETZ$:IF Z$<>""THEN60070
60020 IFZT<=TITHENPRINTMID$(" [166]",ZC,1);"[157]";:ZC=3-ZC:ZT=TI+15
60030 GOTO60010
60070 Z=ASC(Z$):ZL=LEN(IN$):IF(ZAND127)<32THENPRINT" [157]";:GOTO60110
60080 IFFLAND(ZAND127)>64AND(ZAND127)<91THENZ$=CHR$((Z+128)AND255)
60090 IFZL>254THEN60010
60100 IN$=IN$+Z$:PRINTZ$;ZD$;Z$;
60110 IFZ=13THENIN$=MID$(IN$,2):PRINTCR$;:RETURN
60120 IFZ=20ANDZL>1THENIN$=LEFT$(IN$,ZL-1):PRINT"[157]";:GOTO60010
60130 IFZ=141THENZ$=CHR$(-20*(ZL>1)):FORZ=2TOZL:PRINTZ$;:NEXTZ:GOTO60000
60140 GOTO60010